home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
intrfc55.arc
/
INTRFC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-02-25
|
3KB
|
113 lines
program intrfc;
{ Prints out the information contained in a TPU file }
uses
test1,nametype,util,globals,loader,head,blocks,namelist,code,
reloc,dump,params;
var
i,j,t:word;
result : word;
this_unit : obj_ptr;
tpu_size : longint;
main_list : list_ptr;
begin
writeln('INTRFC version 1.2. Written by D.J. Murdoch.');
writeln('Hit break when done.');
parse_params;
read_file('turbo.tpl',pointer(tpl_buffer),0,65535);
if tpl_buffer = nil then
read_file(uses_path+'turbo.tpl',pointer(tpl_buffer),0,65535);
if tpl_buffer <> nil then
begin
got_tpl := true;
tpl_size := last_file_size;
end
else
begin
got_tpl := false;
writeln('Warning: TURBO.TPL not found.');
end;
num_known := 0;
fillchar(unit_list,sizeof(unit_list),0);
add_unit(unitname);
if not unit_list[1]^.has_symbols then
syntax_exit('');
buffer := unit_list[1]^.buffer;
header := normalize(buffer);
{Make this unit refer to itself}
this_unit := add_offset(buffer,header^.ofs_this_unit);
unit_ptr(add_offset(this_unit,length(this_unit^.name)+4))^.target := 1;
add_referenced_units;
with header^ do
begin
code_ofs := roundup(sym_size,16);
const_ofs := code_ofs + roundup(code_size,16);
reloc_ofs := const_ofs + roundup(const_size,16);
vmt_ofs := reloc_ofs + roundup(reloc_size,16);
tpu_size := longint(roundup(sym_size,16))
+longint(roundup(code_size,16))
+longint(roundup(const_size,16))
+longint(roundup(reloc_size,16))
+longint(roundup(vmt_size,16));
end;
hash_table := add_offset(buffer,header^.ofs_hashtable);
if do_implementation in active_options then
hash_table := add_offset(buffer,header^.ofs_full_hash);
{Build main object list}
build_list(main_list,buffer,hash_table);
unit_list[1]^.obj_list := main_list;
{ Now print it }
in_function := false;
indentation := 0;
if do_header in active_options then
print_header;
if [do_name_list,do_implementation]*active_options <> [] then
print_name_list(main_list);
if do_entry_pts in active_options then
print_entries;
if do_code_blocks in active_options then
print_code_blocks;
if do_const_blocks in active_options then
print_const_blocks;
if do_var_blocks in active_options then
print_var_blocks;
if do_unit_blocks in active_options then
print_unit_blocks;
if do_code in active_options then
begin
read_file(unit_list[1]^.path,pointer(code_buf),code_ofs,header^.code_size);
print_dump(code_seg);
freemem(code_buf,header^.code_size);
end;
if do_const in active_options then
begin
read_file(unit_list[1]^.path,pointer(code_buf),const_ofs,header^.const_size);
print_dump(const_seg);
freemem(code_buf,header^.const_size);
end;
if do_reloc in active_options then
begin
read_file(unit_list[1]^.path,pointer(reloc_buf),reloc_ofs,header^.reloc_size);
print_reloc(code_seg);
freemem(reloc_buf,header^.reloc_size);
end;
if do_vmt in active_options then
begin
read_file(unit_list[1]^.path,pointer(reloc_buf),vmt_ofs,header^.vmt_size);
print_reloc(const_seg);
freemem(reloc_buf,header^.vmt_size);
end;
end.